home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0086_Fading UNIT.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  2KB  |  95 lines
  1. UNIT FadeUnit;        { This unit does some fading (I hope!) }
  2.                       { The SetCol procedure lets you change individual}
  3.                       { palette entries , for an easier way, try }
  4.                       { the TP setrgbpalette procedure...}
  5.                       { Regards Florian Ansorge :-) }
  6. INTERFACE
  7.  
  8. Procedure InitCol; {gets the current palette and saves it}
  9.  
  10. Procedure FadeOUT(Duration:Byte);   { lowers/increases the brightness,}
  11. Procedure FadeIN(Duration:Byte);    { duration determines the time it takes}
  12.  
  13. Procedure SetBrightness(Brightness :Byte);
  14.                                     {sets the brightness to brightness / 63 }
  15. IMPLEMENTATION
  16.  
  17. USES Crt, Dos;
  18.  
  19. CONST     PelIdxR  = $3c7; {Port to read}
  20.           PelIdxW  = $3c8; {Port to write}
  21.           PelData  = $3c9; {Dataport}
  22.           Maxreg   = 255;  {Set to 63 for textmode}
  23.           MaxInten = 63;
  24.  
  25. VAR col : ARRAY[0..MaxReg] of RECORD
  26.                                 r, g, b : Byte
  27.                               END;
  28.  
  29. PROCEDURE GetCol(ColNr :Byte; var r, g, b :Byte);
  30. BEGIN
  31.   Port[PelIdxR] := ColNr;
  32.   r := Port[PelData];
  33.   g := Port[PelData];
  34.   b := Port[PelData];;
  35. END;
  36.  
  37. PROCEDURE SetCol(ColNr, r, g, b :Byte); {Change just one colour}
  38. BEGIN
  39.   Port[PelIdxW] := ColNr;
  40.   Port[PelData] := r;
  41.   Port[PelData] := g;
  42.   Port[PelData] := b;
  43. END;
  44.  
  45. PROCEDURE InitCol; {save initial palette}
  46.  
  47. VAR i :Byte;
  48.  
  49. BEGIN
  50.   FOR i := 0 to MaxReg DO
  51.     GetCol(i,col[i].r,col[i].g,col[i].b);
  52. END;
  53.  
  54. PROCEDURE SetBrightness(Brightness :Byte);
  55.  
  56. VAR i          :Byte;
  57.     fr, fg, fb :Byte;
  58.  
  59. BEGIN
  60.   FOR i := 0 to MaxReg DO
  61.   BEGIN
  62.     fr := col[i].r * Brightness DIV MaxInten;
  63.     fg := col[i].g * Brightness DIV MaxInten;
  64.     fb := col[i].b * Brightness DIV MaxInten;
  65.     SetCol(i,fr,fg,fb);
  66.   END;
  67. END;
  68.  
  69. PROCEDURE FadeOUT(Duration :Byte);
  70.  
  71. VAR i :Byte;
  72.  
  73. BEGIN
  74.   FOR i := MaxInten downto 0 DO
  75.   BEGIN
  76.     SetBrightness(i);
  77.     Delay(Duration);
  78.   END;
  79. END;
  80.  
  81. PROCEDURE FadeIN(Duration :Byte);
  82.  
  83. VAR i :Byte;
  84.  
  85. BEGIN
  86.   FOR i := 0 to MaxInten DO
  87.   BEGIN
  88.     SetBrightness(i);
  89.     Delay(Duration);
  90.   END;
  91. END;
  92.  
  93. BEGIN
  94. END.
  95.